home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / getwin1r / zoom.frm < prev   
Text File  |  1999-09-07  |  12KB  |  391 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Begin VB.Form FormView 
  4.    Appearance      =   0  'Flat
  5.    BackColor       =   &H80000005&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "View Picture With ZOOM"
  8.    ClientHeight    =   3840
  9.    ClientLeft      =   45
  10.    ClientTop       =   615
  11.    ClientWidth     =   4455
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   256
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   297
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin MSComDlg.CommonDialog CommonDialog1 
  19.       Left            =   2040
  20.       Top             =   1680
  21.       _ExtentX        =   847
  22.       _ExtentY        =   847
  23.       _Version        =   327681
  24.    End
  25.    Begin VB.PictureBox Picture1 
  26.       BackColor       =   &H80000010&
  27.       BorderStyle     =   0  'None
  28.       Height          =   3615
  29.       Left            =   0
  30.       ScaleHeight     =   241
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   281
  33.       TabIndex        =   2
  34.       Top             =   0
  35.       Width           =   4215
  36.       Begin VB.Image Image1 
  37.          Enabled         =   0   'False
  38.          Height          =   1410
  39.          Left            =   0
  40.          Stretch         =   -1  'True
  41.          Top             =   0
  42.          Width           =   1260
  43.       End
  44.    End
  45.    Begin VB.VScrollBar VScroll1 
  46.       Height          =   3615
  47.       Left            =   4200
  48.       TabIndex        =   1
  49.       Top             =   0
  50.       Width           =   255
  51.    End
  52.    Begin VB.HScrollBar HScroll1 
  53.       Height          =   255
  54.       Left            =   0
  55.       TabIndex        =   0
  56.       Top             =   3600
  57.       Width           =   4215
  58.    End
  59.    Begin VB.Image Image2 
  60.       Height          =   615
  61.       Left            =   5040
  62.       Top             =   840
  63.       Visible         =   0   'False
  64.       Width           =   615
  65.    End
  66.    Begin VB.Menu mnu_file 
  67.       Caption         =   "&File"
  68.       Begin VB.Menu mnu_picture 
  69.          Caption         =   "Open Picture"
  70.       End
  71.       Begin VB.Menu mnu_spacer 
  72.          Caption         =   "-"
  73.       End
  74.       Begin VB.Menu mnu_exit 
  75.          Caption         =   "E&xit"
  76.       End
  77.    End
  78. End
  79. Attribute VB_Name = "FormView"
  80. Attribute VB_GlobalNameSpace = False
  81. Attribute VB_Creatable = False
  82. Attribute VB_PredeclaredId = True
  83. Attribute VB_Exposed = False
  84.    Dim TX As Long
  85.    Dim TY As Long
  86.    Dim ZoomDepth As Long
  87.  
  88.  
  89.    Private Sub Form_Load()
  90.  
  91.  
  92.        'All computer screens (monitors) are NOT the same so
  93.        'we must account for that, and ensure that our
  94.        'software will work properly for every user.
  95.        'Below we set the TX and TY as the first piece of
  96.        'code to be executed.
  97.        'Our Form and PICTURE scalemodes are set at "3" or
  98.        'PIXEL, but when calculating measurements in VB
  99.        'we need to use their dimensions in PIXELS for
  100.        'easier calculation. Our scroll bars work better
  101.        'and quicker in pixels as opposed to TWIPS.
  102.        ' My screen is 15 TWIPS per pixel, so
  103.        'TX and TY will actually equal 15 throughout the
  104.        'entire program. Your screen may be different.
  105.        TX = Screen.TwipsPerPixelX
  106.        TY = Screen.TwipsPerPixelY
  107.    End Sub
  108.  
  109.  
  110.  
  111.    Private Sub HScroll1_Change()
  112.  
  113.  
  114.        HScroll1_Scroll
  115.    End Sub
  116.  
  117.  
  118.  
  119.    Private Sub HScroll1_Scroll()
  120.  
  121.  
  122.        Image1.Left = -HScroll1.Value
  123.    End Sub
  124.  
  125.  
  126.  
  127.    Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  128.  
  129.  
  130.        On Error GoTo BadZoom
  131.        'Here (button 1 / left mouse button), is where we zoom in
  132.        'on the picture
  133.  
  134.  
  135.        If Button = 1 Then
  136.            'I choose 10 as enough times for zooming in
  137.            'and you can change this to a higher or
  138.            'lower number if you want
  139.            If ZoomDepth >= 10 Then Beep: Exit Sub
  140.            'Notice the "Image1.Width / 4" that is used here. This merely
  141.            'increases the image by 25%. You may use a different number
  142.            'than "4" to change your zoom ratio, but make sure you use
  143.            'the same number through your code.
  144.            Image1.Width = Image1.Width + (Image1.Width / 4)
  145.            Image1.Height = Image1.Height + (Image1.Height / 4)
  146.  
  147.  
  148.            If Image1.Width < Picture1.Width Then
  149.                Image1.Left = 0
  150.            Else
  151.                'Else, everything seems to be good
  152.                'so we will zoom in as calculated below.
  153.                'NOTICE that this is where we maintain
  154.                'our "point of view". What I mean is,
  155.                'our mouse cursor is pointed at a specific
  156.                'area of the image, so when we zoom in, we
  157.                'want to see that same area at a closer view.
  158.                'The "X" in the code, directly below, is part
  159.                'of the calculation of the horizontal mouse
  160.                'positio, which in turn sets the scroll bar
  161.                'properly. Thus the image has shifted the
  162.                'correct amount.
  163.                Set_Scrolls
  164.                
  165.  
  166.  
  167.                If HScroll1.Value + ((X / TX) / 4) > HScroll1.Max Then
  168.                    'This "IF" statement makes sure that our scroll value
  169.                    'does not exceed our Scroll MAX when zooming
  170.                    'in near the far right of the image. If it does
  171.                    'exceed, we will use the maximum scroll value
  172.                    HScroll1.Value = HScroll1.Max
  173.                Else
  174.                    HScroll1.Value = HScroll1.Value + ((X / TX) / 4)
  175.                End If
  176.  
  177.  
  178.            End If
  179.  
  180.  
  181.            'The "IF" statement below is the same
  182.            'as the one above, but it will now refer to the
  183.            'image height instead of the width
  184.  
  185.  
  186.            If Image1.Height < Picture1.Height Then
  187.            Else
  188.                Set_Scrolls
  189.  
  190.  
  191.                If VScroll1.Value + ((Y / TY) / 4) > VScroll1.Max Then
  192.                    VScroll1.Value = VScroll1.Max
  193.                Else
  194.                    VScroll1.Value = VScroll1.Value + ((Y / TY) / 4)
  195.                End If
  196.  
  197.  
  198.            End If
  199.  
  200.  
  201.            ZoomDepth = ZoomDepth + 1 'To keep track of how many times we soomed in
  202.            
  203.        ElseIf Button = 2 Then 'Else if button 2 is clicked (right mouse).
  204.            'We will zoom out. The code below is
  205.            'very similar to the code above with
  206.            'some minor changes.
  207.            If Image1.Width <= 10 Then Beep: Exit Sub
  208.            If Image1.Height <= 10 Then Beep: Exit Sub
  209.            Image1.Width = Image1.Width - (Image1.Width / 4)
  210.            Image1.Height = Image1.Height - (Image1.Height / 4)
  211.  
  212.  
  213.            If Image1.Width < Picture1.Width Then
  214.                'Do nothing
  215.            Else
  216.  
  217.  
  218.                If HScroll1.Value - ((X / TX) / 4) > HScroll1.Max Then
  219.                    HScroll1.Value = HScroll1.Max
  220.                ElseIf HScroll1.Value - ((X / TX) / 4) < 1 Then
  221.                    HScroll1.Value = 1
  222.                Else
  223.                    HScroll1.Value = HScroll1.Value - ((X / TX) / 4)
  224.                End If
  225.  
  226.  
  227.            End If
  228.  
  229.  
  230.  
  231.            If Image1.Height < Picture1.Height Then
  232.                Image1.Top = 0
  233.            Else
  234.  
  235.  
  236.                If VScroll1.Value - ((Y / TY) / 4) > VScroll1.Max Then
  237.                    VScroll1.Value = VScroll1.Max
  238.                ElseIf VScroll1.Value - ((Y / TY) / 4) < 1 Then
  239.                    VScroll1.Value = 1
  240.                Else
  241.                    VScroll1.Value = VScroll1.Value - ((Y / TY) / 4)
  242.                End If
  243.  
  244.  
  245.            End If
  246.  
  247.  
  248.            ZoomDepth = ZoomDepth - 1 'Deduct each time we zoom out
  249.        End If
  250.  
  251.  
  252.        Set_Scrolls 'Jump to the "Set_Scrolls Sub" here
  253.        'which will determine when to enable
  254.        'or disable a scroll bar.
  255.        Exit Sub
  256. BadZoom:
  257.        Resume Next
  258.    End Sub
  259.  
  260.  
  261.  
  262.    Private Sub mnu_2_Click()
  263.  
  264.  
  265.    End Sub
  266.  
  267.  
  268.  
  269.    Private Sub mnu_exit_Click()
  270.  
  271.  
  272.        End
  273.    End Sub
  274.  
  275.  
  276.  
  277.    Private Sub mnu_picture_Click()
  278.  
  279.  
  280.